home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue33 / undo / MAIN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-02-17  |  4.6 KB  |  170 lines
  1. unit Main;
  2.  
  3. { This unit contains code for a test MDI program demonstrating
  4.   the use of the undo.pas unit.
  5.  
  6.   Author : Warren Kovach (wlk@kovcomp.co.uk)
  7.   Published in The Delphi Magazine }
  8.  
  9. interface
  10.  
  11. uses WinTypes, WinProcs, SysUtils, Classes, Graphics, Forms, Controls, Menus,
  12.   StdCtrls, Dialogs, Buttons, Messages, ExtCtrls;
  13.  
  14. type
  15.   TMainForm = class(TForm)
  16.     MainMenu1: TMainMenu;
  17.     Panel1: TPanel;
  18.     StatusLine: TPanel;
  19.     File1: TMenuItem;
  20.     Panel2: TPanel;
  21.     Window1: TMenuItem;
  22.     FileExitItem: TMenuItem;
  23.     WindowCascadeItem: TMenuItem;
  24.     WindowTileItem: TMenuItem;
  25.     WindowArrangeItem: TMenuItem;
  26.     Edit1: TMenuItem;
  27.     WindowMinimizeItem: TMenuItem;
  28.     Undo1: TMenuItem;
  29.     Redo1: TMenuItem;
  30.     N3: TMenuItem;
  31.     WindowNewGraphics1: TMenuItem;
  32.     WindowNewText1: TMenuItem;
  33.     WindowChangeFont1: TMenuItem;
  34.     procedure FormCreate(Sender: TObject);
  35.     procedure WindowCascadeItemClick(Sender: TObject);
  36.     procedure UpdateMenuItems(Sender: TObject);
  37.     procedure WindowTileItemClick(Sender: TObject);
  38.     procedure WindowArrangeItemClick(Sender: TObject);
  39.     procedure FileExitItemClick(Sender: TObject);
  40.     procedure WindowMinimizeItemClick(Sender: TObject);
  41.     procedure FormDestroy(Sender: TObject);
  42.     procedure FormShow(Sender: TObject);
  43.     procedure WindowNewGraphics1Click(Sender: TObject);
  44.     procedure WindowNewText1Click(Sender: TObject);
  45.     procedure WindowChangeFont1Click(Sender: TObject);
  46.   private
  47.     { Private declarations }
  48.     procedure ShowHint(Sender: TObject);
  49.     procedure IdleHandler(Sender: TObject; var Done: Boolean);
  50.     procedure WMInitMenuPopup(var Message : TWMInitMenuPopup); message WM_INITMENUPOPUP;
  51.   public
  52.     { Public declarations }
  53.   end;
  54.  
  55. var
  56.   MainForm: TMainForm;
  57.  
  58. implementation
  59.  
  60. {$R *.DFM}
  61.  
  62. uses TextWin, GraphWin, Undo;
  63.  
  64. procedure TMainForm.FormCreate(Sender: TObject);
  65. begin
  66.   Application.OnHint := ShowHint;
  67.   Screen.OnActiveFormChange := UpdateMenuItems;
  68.   Application.OnIdle:= IdleHandler;
  69.   { must do this at run-time because object inspector doen't
  70.     list this alternative }
  71.   Redo1.ShortCut := ShortCut(Word('Z'),[ssShift,ssCtrl]);
  72. end;
  73.  
  74. procedure TMainForm.FormDestroy(Sender: TObject);
  75. begin
  76.   Screen.OnActiveFormChange := nil;
  77. end;
  78.  
  79. procedure TMainForm.FormShow(Sender: TObject);
  80. begin
  81.   TGraphicWindow.Create(Application);
  82.   TTextWindow.Create(Application);
  83. end;
  84.  
  85. procedure TMainForm.ShowHint(Sender: TObject);
  86. begin
  87.   StatusLine.Caption := Application.Hint;
  88. end;
  89.  
  90. procedure TMainForm.FileExitItemClick(Sender: TObject);
  91. begin
  92.   Close;
  93. end;
  94.  
  95. procedure TMainForm.WindowCascadeItemClick(Sender: TObject);
  96. begin
  97.   Cascade;
  98. end;
  99.  
  100. procedure TMainForm.WindowTileItemClick(Sender: TObject);
  101. begin
  102.   Tile;
  103. end;
  104.  
  105. procedure TMainForm.WindowArrangeItemClick(Sender: TObject);
  106. begin
  107.   ArrangeIcons;
  108. end;
  109.  
  110. procedure TMainForm.WindowMinimizeItemClick(Sender: TObject);
  111. var
  112.   I: Integer;
  113. begin
  114.   { Must be done backwards through the MDIChildren array }
  115.   for I := MDIChildCount - 1 downto 0 do
  116.     MDIChildren[I].WindowState := wsMinimized;
  117. end;
  118.  
  119. procedure TMainForm.WindowNewGraphics1Click(Sender: TObject);
  120. begin
  121.   TGraphicWindow.Create(Application);
  122. end;
  123.  
  124. procedure TMainForm.WindowNewText1Click(Sender: TObject);
  125. begin
  126.   TTextWindow.Create(Application);
  127. end;
  128.  
  129. procedure TMainForm.UpdateMenuItems(Sender: TObject);
  130. begin
  131.   WindowCascadeItem.Enabled := MDIChildCount > 0;
  132.   WindowTileItem.Enabled := MDIChildCount > 0;
  133.   WindowArrangeItem.Enabled := MDIChildCount > 0;
  134.   WindowMinimizeItem.Enabled := MDIChildCount > 0;
  135.   if ActiveMDIChild is TUndoForm then begin
  136.     with TUndoForm(ActiveMDIChild) do
  137.       if UndoStack <> nil then
  138.         UndoStack.SetUndoMenuItems(Undo1,Redo1)
  139.       else
  140.         DisableUndoMenus(Undo1,Redo1);
  141.   end;
  142.   WindowChangeFont1.Enabled := ActiveMDIChild is TTextWindow;
  143. end;
  144.  
  145. procedure TMainForm.WMInitMenuPopup(var Message : TWMInitMenuPopup);
  146. begin
  147.   UpdateMenuItems(self);
  148.   inherited;
  149. end;
  150.  
  151. procedure TMainForm.IdleHandler(Sender: TObject; var Done: Boolean);
  152. { must also reset undo/redo menu items enabled property at all
  153.   opportunities; otherwise shortcut keys will not work until menu
  154.   pulled down, since they are disabled by default }
  155. begin
  156.   UpdateMenuItems(Sender);
  157.   { clear all messages before exiting, otherwise changes to menu
  158.     items may cause this to be fired again and again, particularly if
  159.     a lot of changes need to be made. }
  160.   Application.ProcessMessages;
  161. end;
  162.  
  163. procedure TMainForm.WindowChangeFont1Click(Sender: TObject);
  164. begin
  165.   if ActiveMDIChild is TTextWindow then
  166.     TTextWindow(ActiveMDIChild).ChangeFont;
  167. end;
  168.  
  169. end.
  170.